(in-package #:experiment)

(defclass subsequence (state)
  ((children :initarg :children :accessor subsequence-children)
   (index :initform 0 :initarg :index :accessor subsequence-index :documentation "The index into CHILDREN that is the current state.")))


(defgeneric subsequence-count (subseq type &key start end)
  (:documentation "Return the total number of child states of the specified type in the range from START to END."))

(defvar *subsequence-length* nil
  "The length of children in the current subsequence.")

(defvar *subsequence-nth* nil
  "The subsequence's current child's position in the list of children.")

(defmethod subsequence-count ((state subsequence) type &key
                              (start 0)
                              (end (length (subsequence-children state))))
  (loop
     for i in (subseq (subsequence-children state) start end)
     count (typep i type)))

(defmethod state-init (experiment (state subsequence))
  (log experiment 'start :index (subsequence-index state)))

;; (defmethod state-end (experiment (state subsequence))
;;   )

(defmethod state-run (experiment (state subsequence))
  (let ((*subsequence-length* (length (subsequence-children state))))
    (loop
       for i from (subsequence-index state)
       while (< i (length (subsequence-children state)))
       for s = (nth i (subsequence-children state)) do
       (setf (subsequence-index state) i)
       (handler-case
           (let ((*subsequence-nth* i))
             (state-run experiment s))
         (jump (c)
           (setf i (1- (jump-index c))))
         (forward ())
         (backward ()
           (if (> i 0)
               (decf i 2)
               (progn
                 (state-backward experiment state)
                 (setf i -1))))))))

(defmethod state-dump append (experiment (state subsequence))
  `(:index ,(subsequence-index state)
    :children ,(mapcar (lambda (s) (state-dump experiment s)) (subsequence-children state))))

(defmethod compile-state (experiment (state subsequence) args)
  ;; a heuristic to find out if args is a plist or using the old abreviated form.
  (if (every 'listp args)
      (make-instance (type-of state)
                     :parent experiment
                     :children (mapcar (lambda (x) (compile-state experiment (car x) (cdr x)))
                                       args))
      (let ((children (getf args :children))
            (copy (copy-list args)))
        (remf copy :children)
        (apply 'make-instance (type-of state)
               :parent experiment
               :children (mapcar (lambda (x) (compile-state experiment (car x) (cdr x)))
                                 children)
               copy))))


(defgeneric jump-to (exp thing &optional backwardp))

(defmethod jump-to (exp (thing symbol) &optional backwardp)
  (let ((seq (find-if (lambda (s)
                        (typep s 'subsequence))
                      (state-stack exp))))
    (when seq
      (let ((i (if backwardp
                   (position-if (lambda (s)
                                  (typep s thing))
                                (subsequence-children seq)
                                :end (subsequence-index seq)
                                :from-end t)
                   (position-if (lambda (s)
                                  (typep s thing))
                                (subsequence-children seq)
                                :start (1+ (subsequence-index seq))))))
        (when i
          (signal 'jump :index i))))))
